perm filename RHYC.F4[MUS,LCS] blob sn#084623 filedate 1974-01-29 generic text, type T, neo UTF8
C  FILE NAME='RHYC'

C   THIS IS FOR RHYTHMIC INPUT FROM BUTTONS.
C   ORDER FOR EDITING WITH 'CONDUCT'.
C   1. GET LISTING.   2. ADD,DELETE,CHANGE DURATIONS,TEMPO,METER.   
C   3. QUICK TEMPO CHANGES MUST COME LAST!

	DIMENSION IV(200),V(200),W(600)
	COMMON V,N
1700	BB=.1
1032	TYPE 1000
32	X=0
	I=1
	J=1
1000	FORMAT(' INFO? OR WHAT?'/)
	ACCEPT 50,N
50	FORMAT(A1)
	IF(N.EQ.'I')TYPE 2000
	IF(N.EQ.'I')GO TO 1032
2000	FORMAT(' COMMANDS: R(EAD), S(AVE), L(IST), C(ONDUCT),
	1 E(DIT), TAP=<CR>'/' ALL RESTS, AS WELL AS NOTES, MUST BE 
	1 TAPPED.'/' IF THERE ARE NO TAPS FOR 10" THE LAST TAP IS TAKEN AS
	1 THE TERMINATION  OF THE INPUT.'/)
	IF((N.EQ.'R').OR.(N.EQ.'S'))GO TO 6
	IF(N.EQ.'E')GO TO 1013
	IF(N.EQ.'L')GO TO 24
3001	TYPE 1001
1001	FORMAT(' TAP ONCE, THEN PLAY RHYTHM'/)
	CALL RHYTHM(V,II)
	DO 2001 K=II+1,200
2001	V(K)=0
	A=0
	L=1
	IF(N.EQ.'C')L=2
	DO 1021 K=L,II
1021	A=A+V(K)
2021	FORMAT(I4,' NOTES ',F8.3,'"'/)
	L=II
	IF(N.EQ.'C')L=L-1
	TYPE 2021,L,A
21	FORMAT(2F)
	TYPE 12
12	FORMAT(' OK=0,TRY AGAIN=1'/)
	ACCEPT 5,K
	ICON=0
	IF(K.EQ.1)GO TO 3001
	IF(N.NE.'C')GO TO 1032
C   WHEN 'CONDUCTING', UPBEAT MUST BE TAPPED.
C   METER OF UPBEAT (NOTE #0) MAY BE RESET.
	ALLM=1.
	ICON=-1
3012	Q=ALLM
	DO 2012 K=3,II*3,3
2012	W(K)=Q
	IF(ALLM.EQ.X)GO TO 300
	GO TO 1032
24	IF(ICON)GO TO 100
9024	N=0
7024	FORMAT(/' DURATIONS OF NOTES',18XA5,12X,'TOTAL=',F7.3,' SECS.'/)
8024	FORMAT(' NOTE 0 IS UPBEAT (NOT INCLUDED IN DURATION)')
	L=0
	IF(ICON)L=1
	K=1-L
	PRINT 7024,QSLAC,A
	IF(ICON)PRINT 8024
	DO 14 LL=1,40
	KA=K+1
	KB=KA+1
	KC=KB+1
	KD=KC+1
	PRINT 15,K,V(K+L),KA,V(KA+L),KB,V(KB+L),KC,V(KC+L),KD,V(KD+L)
	DO 16 M=1,5
	IF((V(K+M+L).EQ.0).OR.(V(K+M+L).EQ.999.0))GO TO 15
16	CONTINUE
14	K=K+5
15	FORMAT(5('   (',I3,')',F7.3)/)
	CALL EXIT

1013	TYPE 17
17	FORMAT(' TYPE C(HANGE), A(DD NOTE), D(ELETE), T(EMPO CHANGE),
	1'/' M(ETER CHANGE), Q(UICK CHANGE), J(OIN), S(PLIT) OR <CR>'/)
	ACCEPT 50,K
	IF(K.EQ.'-1')GO TO 1013
C   WITH 'CONDUCT', ADDED BEATS ARE IN TERMS OF REAL TIME.
	IF(K.EQ.'M')GO TO 101
	IF((K.NE.'C').AND.(K.NE.'Q'))GO TO 18
	TYPE 19
19	FORMAT(' TYPE NOTE N'/)
 	ACCEPT 5,KA
	IF(KA)GO TO 1013
	IF(K.EQ.'Q')GO TO 120
	L=KA
	IF(ICON)KA=KA+1
	TYPE 20,L,V(KA)
20	FORMAT(' NOTE',I3,' WAS',F9.4,', CHANGE TO ',$)
	X=V(KA)
	ACCEPT 21,V(KA)
	IF(V(KA).LE.0)V(KA)=X
	A=A+V(KA)-X
	IF(ICON+1)GO TO 300
	GO TO 1013
220	FORMAT(' BEAT',I3,', TF1=',F5.3,', TF2=',F5.3,/
	1 ' CHANGE TF1 TO ',$)
120	L=KA*3+1
	TYPE 220,KA,W(L),W(L+1)
	ACCEPT 21,Y
	IF(Y.LE.0)GO TO 1013
	X=W(L+1)+W(L)-Y
	W(L)=Y
	W(L+1)=X
	KA=KA+2
	LA=L+2
	GO TO 1300
C   QUICK CHANGES MUST BE DONE LAST. THEY ARE WIPED OUT WHEN ANY OTHER EDITING IS DONE!
C   THEY MUST BE IN ORDER FROM 1 TO END.

18	IF(K.NE.'A')GO TO 22
	TYPE 23
23	FORMAT(' ADD AFTER WHICH NOTE?'/)
	ACCEPT 5,K
	IF(K)GO TO 1013
	IF(ICON)K=K+1
	TYPE 25
25	FORMAT(' TYPE NOTE VALUE'/)
	ACCEPT 21,X
	IF(X.LE.0)GO TO 18
	A=A+X
125	II=II+1
	IF(ICON)W((II-1)*3)=1.
	L=II+10
	DO 26 M=L,1,-1
	V(M)=V(M-1)
	IF(M-1.NE.K)GO TO 26
	V(M)=X
C   'METERS' MUST BE CHECKED AFTER 'ADD' OR 'DELETE' IS USED.
	IF(ICON)GO TO 2300
	GO TO 1013
26	CONTINUE
	GO TO 1032

22	IF(K.NE.'D')GO TO 229
	TYPE 28
28	FORMAT(' DELETE WHICH NOTE?'/)
 	ACCEPT 5,K
	IF(K)GO TO 1013
	IF(ICON)K=K+1
	A=A-V(K)
429	II=II-1
C   KII WAS 1 IN NEXT LINE.
	DO 29 KA=K,II
29	V(KA)=V(KA+1)
	V(II+1)=0
	IF(ICON)GO TO 2300
	GO TO 1013
229	IF(K.NE.'J')GO TO 329
C   JOINS NOTE TO FOLLOWING NOTE.
	TYPE 19
	ACCEPT 5,K
	IF(ICON)K=K+1
	V(K)=V(K)+V(K+1)
	K=K+1
	GO TO 429

329	FORMAT(' TYPE % FOR 1ST NOTE.'/)
	IF(K.NE.'S')GO TO 35
C   SPLITS NOTE BY %S.
	TYPE 19
	ACCEPT 5,K
	L=K
	IF(ICON)K=K+1
	TYPE 329
	ACCEPT 21,X
	Y=V(K)*X
	X=V(K)-Y
	V(K)=Y
	LA=L+1
	TYPE 529,L,V(K),LA,X
529	FORMAT(2(' NOTE',I3,' =',F6.3/))
	GO TO 125

410	KB=II
	KC=II
	KA=1
1410	G=3.9
	ICNT=1
	LL='9'
	IF(KB.GT.51)KB=51
	KC=KC-KB
	KD=KB*2
310	KK=9
	L=-1
C   WATCH ARRAY LENGTHS HERE.
	J=KB
	IF(KA.GT.1)J=J+3
	DO 210 K=KA*3+1,(J+KA-1)*3-1,3
	X=W(K)
	Y=W(K+1)
	L=L+2
	IV(L)='. ' 
	IV(L+1)=' '
	IF(L.NE.KK)GO TO 1210
2210	IV(L)=-2147483648
	KK=KK+10
1210	IF((Y.LT.G+.05).AND.(Y.GT.G-.05))IV(L+1)=LL
210	IF((X.LT.G+.05).AND.(X.GT.G-.05))IV(L)=LL
	X='  ' 
	IF(ICNT.EQ.10)X=' 180' 
	IF(ICNT.EQ.15)X=' 150' 
	IF(ICNT.EQ.20)X=' 120' 
	IF(ICNT.EQ.30)X='  60' 
	IF(ICNT.EQ.25)X='  90' 
	IF(ICNT.EQ.5)X=' 210' 
	IF(ICNT.EQ.33)X='  42' 
	PRINT 110,X,G,(IV(K),K=1,KD)
	ICNT=ICNT+1
110	FORMAT(A4,F5.1,2X102A1)
	IF(G.LT..4)GO TO 510
	G=G-.1
	LL=LL-536870912
C   ABOVE MOVES '9' TO '0' ETC.
	IF(LL.LT.'0')LL='9'
	GO TO 310
510	IF(KA-2)LB='A'
	IF(LB.GE.'A')LB=LB-536870912
	LL=1
	Y=0
	M=(KB+KA-1)*3
	IF(M-KA*3.GE.150)M=M-1
	DO 610 K=KA*3,M,3
	IV(LL)=' '
	X=W(K)
	IF(X.EQ.1.)GO TO 610
	IF(X.EQ.Y)GO TO 1610
	LB=LB+536870912
	Y=X
1610	IV(LL)=LB
610	LL=LL+1
	IV(LL)=' '
C  WHAT IF LAST BEAT IS NOT 4 16THS?
	KD=KB-KA*(1/KA)
	PRINT 710,(IV(K),K=1,KD)
710	FORMAT(29X,'10',18X,'20',18X,'30',18X,'40'/11X50A2)
C   200 BEAT LIMIT SO FAR.
	LL='A'
	X=1.
	LA=0
	DO 910 K=KA*3,M-1,3
	Y=W(K)
	L=Y/.25
	IF((Y.EQ.X).OR.(Y.EQ.1.).OR.(L.EQ.LA))GO TO 910
	LA=L
	PRINT 1110,LL,L
	LL=LL+536879012
910	X=Y
	IF(KC.LE.0)GO TO 9024
	KA=KB+KA-1
C  CHECK THIS OUT!!
	KB=KC
	PRINT 2410
	GO TO 1410
2410	FORMAT('1')
1110	FORMAT(1XA1,'=',I2,' 16TH NOTES')
35	FORMAT(' TEMPO FACTOR IS 1, CHANGE TO'/)
	IF(K.NE.'T')GO TO 1032
	TYPE 35
	ACCEPT 21,X
	IF(X)GO TO 1013
	A=0
	IF(ICON)A=-V(1)/X
	DO 36 K=1,II
	V(K)=V(K)/X
36	A=A+V(K)
	IF(ICON)GO TO 2300
	GO TO 1032

100	IF(ICON+1)GO TO 410
2300	W(1)=980000.
300	W(2)=II*3-2
	KA=2
	LA=3
	X=Q/V(1)
1300	L=LA
	DO 1200 K=KA,II
	Y=W(L)/V(K)
	W(L+1)=Y
	W(L+2)=Y
1200	L=L+3
	L=LA
3300	DO 500 K=KA,II
	Y=W(L)/V(K)
	Z=Y
	IF(K.LT.II)Z=W(L+4)
	B=ABS(Y-X)
	C=ABS(Z-Y)
	D=B-C/2
	IF(Y-X)GO TO 700
	IF(Z-Y)GO TO 900
	IF(D)GO TO 600
	IF(C.GE..05)B=-D
	IF(C.LT..05)B=-B*BB
C   '.2' IS ARBITRARY.  TO SMOOTH JUMPS IN TEMPO.
	GO TO 200
700	IF(Z-Y.LE.0)GO TO 800
	B=B*.5
	GO TO 200
800	IF(D)GO TO 200
	IF(C.GE..05)B=D
	IF(C.LT..05)B=B*BB
	GO TO 200
900	B=-B*.5
	GO TO 200
600	B=-B
200	W(L+1)=W(L+1)+B
	W(L+2)=W(L+2)-B
	X=W(L+2)
500	L=L+3

	L=L-1
	DO 2100 K=1,7
2100	W(L+K)=999.
	ICON=-2
	IF(N.EQ.'L')GO TO 410
	IF(N.EQ.'E')GO TO 1013
	GO TO 2

101	FORMAT(' CHANGE WHICH BEAT?'/)
	TYPE 101
	ACCEPT 5,KA
C   I.E.  3/8 = 4,8    5/16 = 4,16.

	TYPE 201
201	FORMAT(' TYPE VALUE OF BEAT'/)
	X=0
	ACCEPT 5,(IV(K),K=1,8)
	DO 301 K=1,8
	Y=IV(K)
	IF(Y.LT.99.)GO TO 301
	ALLM=X
	GO TO 3012
C   SETS METER FOR ALL BEATS IF LAST NUMBER IS .GE.99.
301	IF(Y.NE.0)X=X+4./Y
	W(KA*3)=X
	GO TO 300
C   FIX SO CHANGES GO FROM THIS POINT ON.
C   QUICK CHANGES OF TEMPO MUST BE SET (OR RESET) AFTER! ANY OTHER EDITING.
6	TYPE 2
	IF(N.EQ.'R')ICON=0
	IF(ICON.EQ.-1)GO TO 100
2	FORMAT(' TYPE NAME'/)
	ACCEPT 4,QSLAC
	IF(QSLAC.EQ.'-1')GO TO 1032
	IF(QSLAC.NE.' ')GO TO 4
	QSLAC='BIN'
4	FORMAT(A5)
5	FORMAT(8I)
	CALL ZERPP
	IF(ICON)GO TO 1005
	IF(N.EQ.'R') GO TO 27
	DO 102 K=1,II+10
102	W(K)=V(K)
1005	CALL OFILE(1,QSLAC)
10	DO 7 K=1,7
	IF(W(I).EQ.0)W(I)=999.0
7	I=I+1
8	WRITE(1,11)(W(K),K=J,J+6)
	IF((W(I-1).EQ.999.0).OR.(W(I-1).EQ.0))GO TO 9
	J=I
	GO TO 10
C  'V' KEEPS BASIC DATA AT ALL TIMES, 'W' WILL HAVE MODIFIED DATA.(98000,WDCNT,TDUR,T1,T2,ETC.)
9	WRITE(1)II,A,V,Q
	END FILE 1
	CALL EXIT
27	CALL IFILE(1,QSLAC)
30	READ(1,11)(W(K),K=J,J+6)
 	IF(W(J+6).EQ.999.0)GO TO 6013
	J=J+7
	GO TO 30
6013	READ(1)II,A,V,Q
	IF(W(1).GT.999.)ICON=-2
	GO TO 1032
11	FORMAT(1X7F)
111	FORMAT(I,202F)
	END